home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 July / Macworld (1999-07).dmg / Shareware World / Info / For Developers / Mops 3.4.sea / Mops source / PPC source / zObjinit < prev    next >
Text File  |  1999-02-06  |  10KB  |  382 lines
  1. \ Initialization of system objects.
  2.  
  3. syscall AEInstallEventHandler
  4. syscall InstallExceptionHandler
  5.  
  6.  
  7. : -MODELESS    \ Sets normal event handling - no modeless dialogs
  8.     xts{    null-evt    mouse-evt    null-evt    key-evt
  9.             null-evt    key-evt        upd-evt        disk-evt
  10.             actv-evt    null-evt    null-evt    null-evt
  11.             null-evt    null-evt    null-evt    OS-evt
  12.             null-evt    null-evt    null-evt    null-evt
  13.             null-evt    null-evt    null-evt    HL-evt   }
  14.     put: fEvent  ;
  15.  
  16. ' null-evt fill: fevent        \ using -modeless during compilation causes
  17.                             \ strange scrolling effects in fWind
  18.  
  19.  
  20. \        ==================== :PPC_PROC =====================
  21.  
  22. :ppc_code :entry_code
  23.     rOSSP    -256    rOSSP    stwu,
  24.     RTOC    20        rOSSP    stw,
  25.     r13        100        rOSSP    stw,
  26.     r14        104        rOSSP    stw,
  27.     r15        108        rOSSP    stw,
  28.     r16        112        rOSSP    stw,
  29.     r17        116        rOSSP    stw,
  30.     r18        120        rOSSP    stw,
  31.     r19        124        rOSSP    stw,
  32.  
  33.     r13        104        rTOC    lwz,
  34.     r14        108        rTOC    lwz,
  35.     r15        112        rTOC    lwz,
  36.     r16        116        rTOC    lwz,
  37.     r17        120        rTOC    lwz,
  38.     r17        r17        -1024    addi,
  39.     r18        124        rTOC    lwz,
  40.     r18        r18        -4096    addi,
  41.     r19        128        rTOC    lwz,
  42. ;ppc_code
  43.  
  44. :ppc_code ;entry_code
  45.     r13        100        rOSSP    lwz,
  46.     r14        104        rOSSP    lwz,
  47.     r15        108        rOSSP    lwz,
  48.     r16        112        rOSSP    lwz,
  49.     r17        116        rOSSP    lwz,
  50.     r18        120        rOSSP    lwz,
  51.     r19        124        rOSSP    lwz,
  52.     rOSSP    0        rOSSP    lwz,        \ take down frame
  53.                             blr,
  54. ;ppc_code
  55.  
  56.  
  57. (*    :PPC_PROC begins a definition that is to be used as a callback.
  58.     Note that we make no provision to call one of these directly from
  59.     Mops code -- there's really no reason why anyone would want to.
  60.     We use a handler code of BE04, and add some extra info after 
  61.     the header and before the code starts.  This is the logical place
  62.     to put this info, although it means that we can't use "postpone :".
  63.     See the comments in the code below for the nuts and bolts.
  64.  
  65.     At ;ppc_proc time, we add code at the beginning and the end
  66.     to save the regs we're going to change, set up the Mops
  67.     regs, then restore everything at the end.  This is the same
  68.     as what we have to do with :ENTRY words (entry points for
  69.     a shared library).
  70. *)
  71.  
  72.  
  73. : :PPC_PROC  ( procInfo -- 306 )
  74.  
  75.     CDP -> const_data_start
  76.     ppc_header
  77.     $ BE040000 code,        \ handler code for :PPC_proc defns,
  78.                             \  and alignment
  79.  
  80.     align4                    \ align in data area
  81.     CDP                        \ save CDP for reloc!
  82.     0 code,                    \ in code area, space for reloc ptr
  83.     swap code,                \ and then comes the procInfo
  84.     0 code,                    \  2 bytes padding, 2 initial flag bytes
  85.     DP swap reloc!            \ store reloc pointer to data area
  86.  
  87.     12 reserve                \ in data area, leave room for:
  88.                             \    4 bytes:    pointer to routine descriptor
  89.                             \    8 bytes:    transfer vector
  90.                             \ We set these up at fix_procs below, at objinit time.
  91.  
  92.     false -> method?
  93.     false -> noname?
  94.     0 >size: control_stk  0 >size: control_flags
  95.  
  96.     false ppc_entry            \ handle ppc proc entry
  97.     false -> leaf?            \ so our parms get handled consistently
  98.     postpone hide            \ new word is hidden until defn end
  99.     1 -> gpr_rtn_cnt        \ :ppc_procs always return just one result in r3
  100.     -1 -> fpr_rtn_cnt        \ this may need revising $$$$$$$$
  101.     true -> entry?
  102.  
  103.     drop 306                \ use different security marker from colon
  104. ;        immediate
  105.  
  106.  
  107. : ;ppc_proc { \ x -- }
  108.     306 ?defn
  109.     curr-def 2- (;)
  110.     -4 ++> CDP                \ delete the blr
  111.     
  112.     ['] ;entry_code 2+  CDP  36 aligned_move
  113.     36 ++> CDP
  114.  
  115.     ['] :entry_code 2+
  116.     curr-def
  117.     72  aligned_move
  118.  
  119. ;        immediate
  120.  
  121.  
  122.  
  123. konst uppAEEventHandlerProcInfo
  124. :ppc_proc openAppHandler  { x y z -- noErr }  0  ;ppc_proc
  125.  
  126. konst uppAEEventHandlerProcInfo
  127. :ppc_proc openDocHandler  { x y z -- noErr }  0  ;ppc_proc
  128.  
  129. konst uppAEEventHandlerProcInfo
  130. :ppc_proc printDocHandler  { x y z -- noErr }  0  ;ppc_proc
  131.  
  132. konst uppAEEventHandlerProcInfo
  133. :ppc_proc quitAppHandler  { x y z -- noErr }  0  ;ppc_proc
  134.  
  135.  
  136.  
  137. : install_AE_handler  ( aevt-type event-type xt -- )
  138. \    2+ @abs @                \ get the UPP from the :proc info
  139.     0                        \ handlerRefCon = 0
  140.     0                        \ isSysHandler = false
  141.     AEInstallEventHandler  ?startUpError
  142. ;
  143.  
  144.  
  145. : install_reqd_appleEvents
  146.     'type aevt  'type oapp
  147.     ['] openAppHandler            \ AE handler addr
  148.     install_AE_handler
  149.     
  150.     'type aevt  'type odoc
  151.     ['] openDocHandler
  152.     install_AE_handler
  153.     
  154.     'type aevt  'type pdoc
  155.     [']    PrintDocHandler
  156.     install_AE_handler
  157.  
  158.     'type aevt  'type quit
  159.     ['] QuitAppHandler
  160.     install_AE_handler
  161. ;
  162.  
  163.  
  164. \        ===================  EXCEPTIONS ===================
  165.  
  166. (* 
  167. We have to resort to assembly for our exception handler, since
  168. when it's called none or our registers are set up!  We recover
  169. them from the register save area in the exception info (see the
  170. description of this in IM).  Each reg is saved in 8 bytes, so
  171. everything will be compatible on future 64-bit PPCs.  (When
  172. that happens, we'll have to revise this code.  I think it will
  173. be a while yet.)
  174.  
  175. On entry, r3 -> the exception info.
  176.  
  177. Note from Apple:
  178.     An ExceptionHandler is NOT a UniversalProcPtr.
  179.     It must be a native function pointer with NO routine descriptor.
  180. *)
  181.  
  182. variable    temp
  183.  
  184. :ppc_code myExceptionHandler
  185.     r5            0    r3        lwz,        \ r5 = exception type - will be TOS
  186.     r12            8    r3        lwz,        \ r12 -> register info
  187.     r12            r12    4        addi,        \ look at lo 32 bits of regs
  188.     r1            8    r12        lwz,        \ restore r1
  189.     r2            16    r12        lwz,        \ r2
  190.     r3         3 8 *    r12        lwz,        \ we'll get r3 and r4 since that
  191.     r4         4 8 *    r12        lwz,        \  might help in the error dump
  192.     r13        13 8 *    r12        lwz,
  193.     r14        14 8 *    r12        lwz,
  194.     r15        15 8 *    r12        lwz,
  195.     r16        16 8 *    r12        lwz,
  196.     r17        17 8 *    r12        lwz,
  197.     r18        18 8 *    r12        lwz,
  198.     r19        19 8 *    r12        lwz,
  199.     r20        20 8 *    r12        lwz,
  200.     r21        21 8 *    r12        lwz,
  201.  
  202. (*    r22        22 8 *    r12        lwz,        \ not much point in bothering
  203.     r23        23 8 *    r12        lwz,        \  with these
  204.     r24        24 8 *    r12        lwz,
  205.     r25        25 8 *    r12        lwz,
  206.     r26        26 8 *    r12        lwz,
  207.     r27        27 8 *    r12        lwz,
  208.     r28        28 8 *    r12        lwz,
  209.     r29        29 8 *    r12        lwz,
  210.     r30        30 8 *    r12        lwz,
  211.     r31        31 8 *    r12        lwz,
  212. *)
  213.     r0        ' (excep) 2+    dicaddr,    \ we set (excep) up with 3 parms
  214.     r0                        mtctr,
  215.                             bctr,
  216. ;ppc_code
  217.  
  218. : install_my_exception_handler
  219.     ['] myExceptionHandler 2+ temp !
  220.     temp  InstallExceptionHandler  drop
  221. ;
  222.  
  223. : fix_segments  { \ ^ST len segStart #chopped curr_code curr_data -- }
  224.  
  225.     instld?  0EXIT
  226.  
  227.     segTable -> ^ST
  228.     code_start -> curr_code
  229.     code_start 56 + @ -> #chopped
  230.     curr_code #chopped - segTable 4+ !    \ seg 8 base addr (main dic code)
  231.     code_start 4+ @  dup ++> curr_code
  232.     #chopped +            segTable !        \ seg 8 length
  233.     
  234.     data_start -> curr_data
  235.     code_start 60 + @ -> #chopped
  236.     curr_data #chopped - segTable 12 + !    \ seg 9 base addr (main dic data)
  237.     code_start 8 + @  dup ++> curr_data
  238.     #chopped +            segTable 8 + !    \ seg 9 length
  239.  
  240.     max_segs 2
  241.     DO    i  8 *  segTable +  -> ^ST
  242.         ^ST c@ 1 and
  243.         IF            \ this one is installed
  244.             ^ST @ $ 00ffffff and #align4  -> len
  245.             i 1 and
  246.             IF        \ it's data
  247.                 curr_data  ^ST 4+ !
  248.                 len ++> curr_data
  249.             ELSE    \ it's code
  250.                 curr_code  ^ST 4+ !
  251.                 len ++> curr_code
  252.             THEN
  253.         THEN
  254.     LOOP
  255. ;
  256.  
  257. : chk_thread  { thread# \ thread_addr prev_lfa lfa -- }
  258.  
  259.     thread# dummy_len c!                \ fake a "length byte" for THREAD
  260.     dummy_len thread  -> thread_addr    \ addr of thread start in CONTEXT
  261.     
  262.     thread_addr displace  -> lfa        \ addr of first link field in thread,
  263.                                         \  in CONTEXT
  264.     lfa -> prev_lfa
  265.     BEGIN    lfa
  266.     WHILE    lfa -> prev_lfa
  267.             lfa displace -> lfa
  268.     REPEAT
  269. ;
  270.  
  271.  
  272. : chkdic
  273.     #threads  FOR  i chk_thread  NEXT
  274. ;
  275.  
  276.  
  277. \ Any special run-time initialization can be done conveniently by adding
  278. \ the appropriate words to the x-col INIT_ACTIONS.  These words will be
  279. \ executed on startup via EXTRA_INITS, right after the rest of the
  280. \ initialization stuff has been done.
  281.  
  282.     8    x-col    INIT_ACTIONS
  283.  
  284.  
  285. : EXTRA_INITS
  286.     size: init_actions  0  ?DO  i exec: init_actions  LOOP
  287. ;
  288.  
  289.  
  290. : SYSINIT        \ our final initialization word.  Called regardless ofwhether 
  291.                 \  we're in the development environment or an installed app.
  292.     init2
  293.     fix_segments
  294. \    fix_procs        \ jan 99 - now we check at [']-time, so we can have
  295.                     \  ppc_procs in modules.  See qpCond.
  296.     install_reqd_appleEvents
  297.     install_my_exception_handler
  298.     0 -> actW
  299.     resize_fWind
  300.     $ F5EF  setMask: fEvent        \ mask out key up
  301.     -modeless   key!  +curs
  302.     extra_inits                    \ do any extra initialization
  303. ;
  304.  
  305. (*
  306. PAUSE should be called at strategic intervals in all applications,
  307. unless Key is being called frequently (see note 1 below).  Pause
  308. normally calls  next: fEvent  which allows a task switch to be done
  309. under MultiFinder, and which also handles any pending events for this
  310. task, such as window updates.  Remember to disable any menus etc. that
  311. you don't want to execute in this situation!  Unexpected re-entrancy
  312. is a good way to bomb!
  313.  
  314. NOTE THE FOLLOWING POINTS:
  315.  
  316. 1.  KEY also calls  next: fEvent.  So if we're waiting on keys,
  317. we shouldn't call Pause, especially as Pause will gobble any keys
  318. typed!
  319.  
  320. 2.  next: fEvent  calls WaitNextEvent.  If we don't want to be
  321. suspended until the next event for us, we need to set SleepTicks to
  322. a suitably low number.  PAUSE by default sets SleepTicks to zero
  323. temporarily.  Change this if necessary.
  324.  
  325. 3.  If multitasking is installed, PAUSE may be redirected (but not
  326. necessarily) so that it just calls NEXT_TASK to do a task switch.
  327. This will happen if we have a foreground task calling  next: fEvent
  328. repeatedly, while we do all the real work in the background.
  329. This way we can keep executing during window drags and menu selections.
  330.  
  331. 4.  Dereferenced pointers may become invalid across a PAUSE.  Be careful.
  332. *)
  333.  
  334. : (PAUSE)
  335.     savingDic?  ?EXIT        \ If called during a dic save, mustn't process
  336.                             \  events since modules are purged
  337.     sleepticks  0 -> sleepticks
  338.     getMask: fEvent  $ FFC7 setMask: fEvent        \ all except key events
  339.     next: fEvent  \ IF  2drop  THEN    \ 30Apr94 DBH next: no longer returns stack items
  340.     setMask: fEvent   -> sleepticks  ;
  341.  
  342.  
  343. \ CL3 is the next cleanup word - it cleans up all object stuff on abort,
  344. \ as well as whatever we were doing before (see CL2 in file Files, and CL1
  345. \ in file Class).
  346.  
  347. : CL3
  348.     ( key! )  0 HiliteMenu   arrowcurs
  349.     cl2  ;
  350.  
  351.  
  352. : (SF)
  353.     alive: fWind IF  setContRect: fWind  set: fWind  select: fWind  THEN
  354.     initfont  ;
  355.  
  356.  
  357. ' sysinit    -> objinit
  358. ' (pause)    -> pause
  359. ' (sf)        -> setFwind
  360. ' cl3        -> abortvec
  361.  
  362.  
  363. :f RUN
  364.     cr ." This is the stage 3 nucleus." cr
  365.     QUIT
  366. ;f
  367.  
  368.  
  369. \ ========= Some ppc_procs we need which are used in modules =========
  370.  
  371. \ TEScroller
  372.  
  373. nilP    value    ClickedScroller
  374.  
  375.  
  376. konst uppTEClickLoopProcInfo
  377.  
  378. :ppc_proc  DRAGPROC
  379.     autoScroll: [ clickedScroller ]
  380.     1                \ We have to return a Pascal boolean TRUE!
  381. ;ppc_proc
  382.